home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / reduce.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  13KB  |  518 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* This file contains various functions needed for reduce actions */
  10.  
  11. #include "hdr.h"
  12. #include "ada.h"
  13. #include "adared.h"
  14. #include "setp.h"
  15. #include "smiscp.h"
  16. #include "prsutilp.h"
  17. #include "errsp.h"
  18. #include "adalexp.h"
  19. #include "pspansp.h"
  20. #include "reducep.h"
  21.  
  22. static void pragma_warning(Node);
  23. static int in_label_set(Node, Tuple);
  24. static int is_pragma(int);
  25.  
  26. void free_everything(Node n)
  27. {
  28. }
  29.  
  30. struct two_pool *initlist(Node node)                /*;initlist*/
  31. {
  32.     /* Allocate a single list structure (struct two_pool), set its data to
  33.      * be a pointer to the node given, and set its link field to point
  34.      * to itself, since tree node lists are circular.
  35.      */
  36.     struct two_pool *tmp;
  37.  
  38.     tmp = TALLOC();
  39.     tmp->val.node = node;
  40.     tmp->link = tmp;
  41.     return(tmp);
  42. }
  43.  
  44. void append(Node orignode, Node node)            /*;append*/
  45. {
  46.     /* Append node to list within orignode */
  47.  
  48.     if (N_LIST(orignode) == (Tuple)0) 
  49.         N_LIST(orignode) = tup_new1((char *)node);
  50.     else
  51.         N_LIST(orignode) = tup_with(N_LIST(orignode), (char *)node);
  52. }
  53.  
  54. void prepend(Node node, Node orignode)        /*;prepend*/
  55. {
  56.     /* Prepends list within orignode with node */
  57.  
  58.     Tuple beglist = tup_new1((char *)node);
  59.  
  60.     if (N_LIST(orignode) == (Tuple)0)
  61.         N_LIST(orignode) = beglist;
  62.     else
  63.         N_LIST(orignode) = tup_add(beglist, N_LIST(orignode));
  64. }
  65.  
  66. Node binary_operator(Node optr, Node expr1, Node expr2)        /*;binary_operator*/
  67. {
  68.     /* Set up the AST node for a binary operator. */
  69.  
  70.     Node node, arg_list_node;
  71.  
  72.     node = node_new(as_op);
  73.     arg_list_node = node_new(as_list);
  74.     N_LIST(arg_list_node) = tup_new2((char *)expr1, (char *)expr2);
  75.     insert_2child(node, optr, arg_list_node);
  76.     return(node);
  77. }
  78.  
  79. Node unary_operator(Node optr, Node expr)                /*;unary_operator*/
  80. {
  81.     /* Set up the AST node for a unary operator. */
  82.     Node node, arg_list_node;
  83.  
  84.     node = node_new(as_un_op);
  85.     arg_list_node = node_new(as_list);
  86.     N_LIST(arg_list_node) = tup_new1((char *)expr);
  87.     insert_2child(node, optr, arg_list_node);
  88.     return(node);
  89. }
  90.  
  91. int check_expanded_name(Node name)            /*;check_expanded_name*/
  92. {
  93.     /* Make sure an expanded name node is valid. */
  94.  
  95. #define sub_expanded_name (N_AST1(name))
  96.     return((N_KIND(name) == as_selector) ? 
  97.       check_expanded_name(sub_expanded_name) : (N_KIND(name)== as_simple_name));
  98. #undef sub_expanded_name
  99. }
  100.  
  101. void check_discrete_range(Node discrete_range) /*;check_discrete_range*/
  102. {
  103.     /* Check whether a discrete range node is valid. */
  104.  
  105.     switch (N_KIND(discrete_range))
  106.     {
  107.     case as_range_expression :
  108. #define name (N_AST1(discrete_range))
  109.         if (!check_expanded_name(name))
  110.             syntax_err(SPAN(discrete_range),
  111.               "Invalid discrete_range specification");
  112.         else
  113.             N_KIND(discrete_range) = as_name;
  114.         break;
  115. #undef name
  116.     case as_range_attribute :
  117.     case as_subtype :
  118.         break;
  119.     default :
  120.         syntax_err(SPAN(discrete_range),
  121.           "Invalid discrete_range specification");
  122.     }
  123. }
  124.  
  125. static void pragma_warning(Node pragma_node)            /*;pragma_warning*/
  126. {
  127.     /* Give a warning that a pragma is ignored. */
  128.  
  129.     char msg[MAXLINE + 30];
  130.  
  131. #define id (N_AST1(pragma_node))
  132.     sprintf(msg,"Pragma %s is ignored", namelist(N_ID(id)));
  133.     prs_warning(SPAN(pragma_node),msg);
  134. #undef id
  135. }
  136.  
  137. void pragmalist_warning(Node list_node)        /*;pragmalist_warning*/
  138. {
  139.     /* For all nodes in the list of list_node give a warning the the pragma
  140.      * is invalid.
  141.      */
  142.  
  143.     Node tmp_node;
  144.     Fortup ft1;
  145.  
  146.     if (N_LIST(list_node) != (Tuple)0) {
  147.         FORTUP(tmp_node = (Node), N_LIST(list_node), ft1);
  148.             pragma_warning(tmp_node);
  149.         ENDFORTUP(ft1);
  150.     }
  151. }
  152.  
  153. void check_pragmas(Node pragma_node, int (*allowed_test)(int))
  154.                                                     /*;check_pragmas*/
  155. {
  156.     /* Check that a pragma is valid. */
  157.  
  158.     Tuple new_list = tup_new(0);
  159.     Node tmp_node;
  160.     Fortup ft1;
  161.     int id;
  162.  
  163.     if (N_LIST(pragma_node) != (Tuple)0) {
  164.         FORTUP(tmp_node = (Node), N_LIST(pragma_node), ft1);
  165.             id = N_ID(N_AST1(tmp_node));
  166.             if (is_pragma(id) && (*allowed_test)(id - MIN_PRAGMA)) {
  167.                 if (strcmp(namelist(id),"PRIORITY")
  168.                   && strcmp(namelist(id),"ELABORATE")
  169.                   && strcmp(namelist(id),"INTERFACE")) {
  170.                     pragma_warning(tmp_node);
  171.                 }
  172.                 else
  173.                     new_list = tup_with(new_list, (char *)tmp_node);
  174.             }
  175.             else if (is_pragma(id) && ispredef_pragma[id - MIN_PRAGMA]) {
  176.                 char msg[200];
  177.  
  178.                 sprintf(msg,"Pragma %s is not valid in this context",
  179.                   namelist(id));
  180.                 prs_warning(SPAN(tmp_node),msg);
  181.             }
  182.             else if (!(is_pragma(id) && isimpldef_pragma[id - MIN_PRAGMA])
  183.               && strcmp(namelist(id),"OPTIMIZE")) {
  184.                 pragma_warning(tmp_node);
  185.             }
  186.             else
  187.                 new_list = tup_with(new_list, (char *)tmp_node);
  188.         ENDFORTUP(ft1);
  189.         N_LIST(pragma_node) = new_list;
  190.     }
  191. }
  192.  
  193. int isoverloadable_op(char *str)                /*;isoverloadable_op*/
  194. {
  195.     /* Check whether a string represnts an overloadable operator by
  196.      * comparing against all overloadable operators.
  197.      */
  198.  
  199.     char tmp[MAXLINE + 1];
  200.     int i;
  201.  
  202.     strcpy(tmp, str);
  203.     convtolower(tmp);
  204.     for (i = 0; i < NUMOVERLOADOPS; i++)
  205.         if (!strcmp(tmp, overloadable_operators[i]))
  206.             return(1);
  207.     return(0);
  208. }
  209.  
  210. /* The following functions are for passing to check_pragmas */
  211.  
  212. int immediate_decl_pragmas(int p)                /*;immediate_decl_pragmas*/
  213. {
  214.     return(isimmediate_decl_pragma[p]);
  215. }
  216.  
  217. int compilation_pragmas(int p)                    /*;compilation_pragmas*/
  218. {
  219.     return(iscompilation_pragma[p]);
  220. }
  221.  
  222. int after_libunit_pragmas(int p)                /*;after_libunit_pragmas*/
  223. {
  224.     return(isafter_libunit_pragma[p]);
  225. }
  226.  
  227. int task_pragmas(int p)                            /*;task_pragmas*/
  228. {
  229.     return(istask_pragma[p]);
  230. }
  231.  
  232. int task_repr_pragmas(int p)                    /*;task_repr_pragmas*/
  233. {
  234.     return(istask_pragma[p] || isrepr_pragma[p]);
  235. }
  236.  
  237. int context_pragmas(int p)                        /*;context_pragmas*/
  238. {
  239.     return(iscontext_pragma[p]);
  240. }
  241.  
  242. int null_pragmas(int i)                                    /*;null_pragmas*/
  243. {
  244.     return(i = 0);
  245. }
  246.  
  247. void check_choices(Node alt_node, char *source)    /*;check_choices*/
  248. {
  249.     Tuple choice_list, others_indices = tup_new(0);
  250.     Node tmp_node, tmp_node2, last_alt = (Node) 0;
  251.     Fortup ft1, ft2;
  252.     int choice_flag = 0;
  253.  
  254.     FORTUP(tmp_node = (Node), N_LIST(alt_node), ft1);
  255.         if (N_KIND(tmp_node) != as_pragma) {
  256.             choice_list = N_LIST(N_AST1(tmp_node));
  257.             if (tup_size(choice_list) > 1) {
  258.                 FORTUP(tmp_node2 = (Node), choice_list, ft2);
  259.                     if (N_KIND(tmp_node2) == as_others
  260.                       || N_KIND(tmp_node2) == as_others_choice) {
  261.                         char msg[90];
  262.  
  263.                         sprintf(msg,"The choice OTHERS must appear alone in %s",
  264.                           source);
  265.                         syntax_err(SPAN(tmp_node2),msg);
  266.                         choice_flag = 1;
  267.                         break;
  268.                     }
  269.                 ENDFORTUP(ft2);
  270.             }
  271.                if (!choice_flag) {
  272.                 if (N_KIND((Node)choice_list[1]) == as_others
  273.                   || N_KIND((Node)choice_list[1]) == as_others_choice)
  274.                     others_indices = tup_with(others_indices, (char *)tmp_node);
  275.             }
  276.             else
  277.                 choice_flag = 0;
  278.             last_alt = tmp_node;
  279.         }
  280.     ENDFORTUP(ft1);
  281.  
  282.     FORTUP(tmp_node = (Node), others_indices, ft1); {
  283.         Node choice;
  284.         char msg[90];
  285.  
  286.         if (tmp_node == last_alt)
  287.             continue;
  288.         choice = (Node)N_LIST(N_AST1(tmp_node))[1];
  289.         sprintf(msg,"The choice OTHERS must appear last in %s",source);
  290.         syntax_err(SPAN(choice),msg);
  291.     } ENDFORTUP(ft1);
  292. /*
  293.     if (others_indices != (struct two_pool *)0 )
  294.         TFREE(others_indices->link,others_indices);
  295. */
  296. }
  297.  
  298. Tuple remove_duplicate_labels(Tuple label_list)
  299.                                             /*;remove_duplicate_labels*/
  300. {
  301.     Tuple new_label_list = tup_new(0), label_id_set = tup_new(0);
  302.     Fortup ft1, ft2;
  303.     Node tmp_node, tmp_node2, node, label;
  304.  
  305.     FORTUP(tmp_node = (Node), label_list, ft1);
  306.         if (N_KIND((node = tmp_node)) == as_simple_name) {
  307.             if (in_label_set(node, label_id_set))
  308.                 syntax_err(SPAN(node),"Duplicate label name");
  309.             else {
  310.                 /* new_label_list = concatl(new_label_list,initlist(node)); */
  311.                 label_id_set = tup_with(label_id_set, (char *)node);
  312.             }
  313.             new_label_list = tup_with(new_label_list, (char *)node);
  314.         }
  315.         else {
  316.             FORTUP(tmp_node2 = (Node), N_LIST(node), ft2);
  317.                 label = tmp_node2;
  318.                 if (in_label_set(label,label_id_set))
  319.                     syntax_err(SPAN(label),"Duplicate label name");
  320.                 else
  321.                     label_id_set = tup_with(label_id_set, (char *)label);
  322.             ENDFORTUP(ft2);
  323.         }
  324.     ENDFORTUP(ft1)
  325. /*
  326.     if (label_id_set != (struct two_pool *)0)
  327.         TFREE(label_id_set->link,label_id_set);
  328.     if (label_list != (struct two_pool *)0)
  329.         TFREE(label_list->link,label_list);
  330. */
  331.     return(new_label_list);
  332. }
  333.  
  334. static int in_label_set(Node label, Tuple label_set)
  335.                                                         /*;in_label_set*/
  336. {
  337.     int val = N_ID(label);
  338.     Node tmp_node;
  339.     Fortup ft1;
  340.  
  341.     FORTUP(tmp_node = (Node), label_set, ft1);
  342.         if (N_ID(tmp_node) == val)
  343.             return(1);
  344.     ENDFORTUP(ft1);
  345.     return(0);
  346. }
  347.  
  348. void ins_as_line_no(Node node)                /*;ins_as_line_no*/
  349. {
  350.     /* insert as_line_no nodes before each item in declarative/stmt list */
  351.  
  352.     Tuple new_list = tup_new(0);
  353.     Node tmp_node;
  354.     Fortup ft1;
  355.     Node line_node;
  356.     Span line_node_span;
  357.  
  358.  
  359.     FORTUP(tmp_node = (Node), N_LIST(node), ft1);
  360.         line_node = node_new (as_line_no);
  361.         line_node_span = get_left_span_p(tmp_node);
  362.         N_ID(line_node) = line_node_span->line;
  363.         set_span(line_node,line_node_span);
  364.         /* Insert a new node with the as_line_no between dec_list and its 
  365.                 predecessor */
  366.         new_list = tup_with(new_list, (char *)line_node);
  367.         new_list = tup_with(new_list, (char *)tmp_node);
  368.     ENDFORTUP(ft1);
  369.     N_LIST(node) = new_list;
  370. }
  371.  
  372. void end_as_line_no(Node list_node, struct prsstack *next_token)
  373.                                                     /*;end_as_line_no*/
  374. {
  375.     /* add an as_line_no node to end of statement list this is the line
  376.      * number of the token following the sequence of statements
  377.      */
  378.  
  379.     Node  line_node;
  380.  
  381.     if (N_LIST(list_node) != (Tuple)0) {
  382.         line_node = node_new (as_line_no);
  383.         N_ID(line_node) = next_token->ptr.token->span.line ;
  384.         set_span(line_node, make_span(N_ID(line_node),
  385.           next_token->ptr.token->span.col));
  386.         N_LIST(list_node) = tup_with(N_LIST(list_node), (char *)line_node);
  387.     }
  388. }
  389.  
  390. #define LABELSMAPSIZE 50
  391.  
  392. struct labelsmap {
  393.     Node node;
  394.     Tuple list;
  395.     struct labelsmap *link;
  396. };
  397.  
  398. struct labelsmap *nodetolabelstable[LABELSMAPSIZE]; /* Table for Labels map */
  399. /* List of free label structures */
  400. static struct labelsmap *deadlabels = (struct labelsmap *)0;
  401.  
  402. unsigned long labelshash(Node node)            /*;labelshash*/
  403. {
  404.     /* The hash function from nodes to integers */
  405.     return( ((unsigned long) node) % LABELSMAPSIZE);
  406. }
  407.  
  408. void newlabels(Node node, Tuple list)        /*;newlabels*/
  409. {
  410.     /* Add node to the map, and initialize its labels list to list.
  411.      * Storage allocation is done using malloc/free structure list.
  412.      */
  413.  
  414.     int pos;
  415.     struct labelsmap *labelnode;
  416.  
  417.     pos = (int)labelshash(node);
  418.     if (deadlabels == (struct labelsmap *)0)
  419.         labelnode = (struct labelsmap *)malloc(sizeof(struct labelsmap));
  420.     else {
  421.         labelnode = deadlabels;
  422.         deadlabels = deadlabels->link;
  423.     }
  424.     labelnode->link = nodetolabelstable[pos];
  425.     nodetolabelstable[pos] = labelnode;
  426.     labelnode->node = node;
  427.     labelnode->list = list;
  428. }
  429.  
  430. Tuple getlabels(Node node)                /*;getlabels*/
  431. {
  432.     /* Return the list of labels corresponding to a given node. If
  433.      * The map is not defined for a node, NULL is returned.
  434.      */
  435.  
  436.     struct labelsmap *tmp;
  437.  
  438.     for (tmp = nodetolabelstable[labelshash(node)];
  439.       tmp != (struct labelsmap *)0 && tmp->node != node; tmp = tmp->link);
  440.     return((tmp == (struct labelsmap *)0) ? tup_new(0) : tmp->list);
  441. }
  442.  
  443. void erase_labels(Node node)                        /*;erase_labels*/
  444. {
  445.     /* Remove a node from the labels map, freeing the structure used for
  446.      * that node's labels.
  447.      */
  448.  
  449.     struct labelsmap *tmp, *last;
  450.     int pos;
  451.  
  452.     pos = (int)labelshash(node);
  453.     for (tmp = nodetolabelstable[pos], last = (struct labelsmap *)0; 
  454.       tmp != (struct labelsmap *)0 && tmp->node != node;
  455.       last = tmp, tmp = tmp->link);
  456.     if (tmp == (struct labelsmap *)0)
  457.         return;
  458.     if (last == (struct labelsmap *)0)
  459.         nodetolabelstable[pos] = tmp->link;
  460.     else
  461.         last->link = tmp->link;
  462.     tmp->link = deadlabels;
  463.     deadlabels = tmp;
  464. /*
  465.     if (tmp->list != (struct two_pool *)0)
  466.         TFREE(tmp->list->link,tmp->list);
  467. */
  468. }
  469.  
  470. void free_labels()                                            /*;free_labels*/
  471. {
  472.     /* Remove all entries in the labels map. */
  473.     int i;
  474.     struct labelsmap *curr;
  475.  
  476.     for (i = 0; i < LABELSMAPSIZE; i++)
  477.         if (nodetolabelstable[i] != (struct labelsmap *)0) {
  478.             for (curr = nodetolabelstable[i]; curr->link!=NULL; curr=curr->link)
  479.                 if (curr->list != NULL)
  480.                     ;/*TFREE(curr->list->link,curr->list);*/
  481.             curr->link = deadlabels;
  482.             deadlabels = nodetolabelstable[i];
  483.             nodetolabelstable[i] = NULL;
  484.         }
  485. }
  486.  
  487. static int is_pragma(int n)                                 /*;is_pragma*/
  488. {
  489.     /* Metaware miscompiles if:
  490.     return (MIN_PRAGMA <= (n) && (n) <= MAX_PRAGMA);
  491.      * so reorder first test until MetaWare compiler bug fixed
  492.      */
  493.     return ((n)>=MIN_PRAGMA  && (n) <= MAX_PRAGMA);
  494. }
  495.  
  496. void insert_1child(Node into, Node a1)
  497. {
  498.     N_AST1(into) = a1;
  499. }
  500. void insert_2child(Node into, Node a1, Node a2)
  501. {
  502.     N_AST1(into) = a1;
  503.     N_AST2(into) = a2;
  504. }
  505. void insert_3child(Node into, Node a1, Node a2, Node a3)
  506. {
  507.     N_AST1(into) = a1;
  508.     N_AST2(into) = a2;
  509.     N_AST3(into) = a3;
  510. }
  511. void insert_4child(Node into, Node a1, Node a2, Node a3, Node a4)
  512. {
  513.     N_AST1(into) = a1;
  514.     N_AST2(into) = a2;
  515.     N_AST3(into) = a3;
  516.     N_AST4(into) = a4;
  517. }
  518.